home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 2
/
Gold Medal Software Volume 2 (Gold Medal) (1994).iso
/
utils
/
inter37d.arj
/
RB2NG102.ARJ
/
RB2NG.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-04-18
|
21KB
|
833 lines
{
╔══════════════════╗
║ Ralf Brown's NG ║
║ Interrupt List ║
║ Rev. 1.02 ║
╚══════════════════╝
}
Program RBNG;
{$F-} {$O-} {$A+} {$G-}
{$V-} {$B-} {$X-} {$N+} {$E+}
{$I FINAL.PAS}
{$IFDEF FINAL}
{$I-} {$R-}
{$D-} {$L-} {$S-}
{$M 8192,0,0}
{$ENDIF}
Uses CRT,Strings;
Type
ConvertType = Array [1..100] of
Record
IfThis :String[10];
ThenThis:String[10];
End;
Var
BatchJob,
MenuLink,
F,G :Text;
L :String;
SeeAlsoLine :String;
IntFiles :Array[0..255] of String[12];
Procedure Pad(Total,WithChar:Byte);
Begin
For Total:=1 to Total do {As many times as requested}
Write(Chr(WithChar)); {write the char}
End; {Pad}
Procedure EditString(X,Y,MaxLets:Byte;Upper:Boolean;Var MainStr:String);
Var
Ins :Boolean; {Boolean for the Insert Key Status}
C :Char; {Current Character}
CurXPos,
Count :Byte; {Number Of Chars In String}
Begin
Ins:=False; {The Insert key has not yet been pressed}
CurXPos:=1; {Current Relative X Position+1}
GotoXY(X,Y);
UnPadVar(MainStr,MainStr);
If Length(MainStr)>MaxLets Then
MainStr:=Copy(MainStr,1,MaxLets);
Write(MainStr);
Pad(MaxLets-Length(MainStr),32);
Count:=Length(MainStr)+1; {How many letters in the string+1}
Repeat {Repeat Until [Return] is Pressed}
GotoXY(X+CurXPos-1,Y); {Goto the Requested Area}
If Upper Then
C:=UpCase(ReadKey)
Else
C:=ReadKey;
If C=Chr(0) Then {Check for a cursor key}
Begin
C:=ReadKey; {Which cursor key} {Numeric Keypad Value}
If (C='O') Then CurXPos:=Count; {1}
If (C='P') And (CurXPos>=3) Then Dec(CurXPos,2); {2}
If (C='Q') And (CurXPos>=4) Then Dec(CurXPos,3); {3}
If (C='K') And (CurXPos>1) Then Dec(CurXPos); {4}
If (C='M') And (CurXPos<Count) Then Inc(CurXPos); {6}
If (C='G') Then CurXPos:=1; {7}
If (C='H') And (CurXPos<=Count-2) Then Inc(CurXPos,2); {8}
If (C='I') And (CurXPos<=Count-3) Then Inc(CurXPos,3); {9}
If (C=#7 ) Then MainStr[0]:=Chr(CurXPos-1); {Shift-Del}
If (C='S') And (Count>1) Then {Del}
Begin
Delete(MainStr,CurXPos,1);
GotoXY(X,Y);
Write(MainStr,' ');
Dec(Count);
GotoXY(X-1+CurXPos,Y);
End;
If (C='R') Then {Ins}
Begin
Ins:=Not Ins;
End;
GotoXY(X-1+CurXPos,Y);
End {End Extended Key}
Else
Begin
If (C=#17) Then {^Q}
Begin
C:=ReadKey;
If C=#0 Then
C:=ReadKey
Else
If C in ['y','Y',#25] Then
Begin
MainStr[0]:=Chr(CurXPos-1);
Count:=CurXPos;
GotoXY(X,Y);
Write(MainStr);
Pad(MaxLets-Length(MainStr),32);
End;
End
Else
If (C=#27) Then
Begin
GotoXY(X,Y);
Pad(MaxLets,32);
MainStr:='';
C:=#13;
End
Else
If (C=#8) Then {Was BackSpace Presssed?}
Begin
If (CurXPos>1) Then {Can I BackSpace?}
Begin
Delete(MainStr,CurXPos-1,1); {Delete the char}
GotoXY(X,Y);
Write(MainStr,' '); {Redisplay the String}
Dec(Count); {One less char}
Dec(CurXPos); {Move Back}
GotoXY(X-1+CurXPos,Y); {Goto Position}
End; {End 'Can I BackSpace?'}
End {End 'Was BackSpace Pressed?'}
Else {No Not BackSpace - A Normal Letter}
If (CurXPos<=MaxLets) And (C<>#13) Then {Is there Space?}
Begin
If Ins Or (CurXPos>=Count) Then {Must I Insert the Char?}
Begin
If Count<=MaxLets Then
Begin
Insert(C,MainStr,CurXPos); {Insert the Char}
Inc(Count); {Add 1 to Count}
Inc(CurXPos); {Move Cursor}
End; {End Check for Space in String}
End {End Check to see if Ins was True}
Else {No, Do not Insert, Overwrite}
Begin
MainStr[CurXPos]:=C; {Overwrite char}
Inc(CurXPos); {Move Cursor}
End; {End Insert / Overwrite}
If CurXPos<Count Then {If the char was Inserted, Rewrite}
Begin {the entire String to the screen}
GotoXY(X,Y);
Write(MainStr);
GotoXY(X-1+CurXPos,Y);
End {End Rewrite the String to the screen}
Else {Need Not Rewrite the entire String}
Write(C); {Just Display the new char}
End;
End; {End Area which accepts a BackSpace or a Letter}
Until C=#13;
UnPadVar(MainStr,MainStr);
End;
Function HexToDec(Hex:String):Word;
Var
Temp :Word;
Begin
Temp:=0;
UpperCase(Hex,Hex);
If Hex[1] in ['0'..'9'] Then Temp:=Temp + (Ord(Hex[1])-Ord('0'))*16;
If Hex[1] in ['A'..'F'] Then Temp:=Temp + (Ord(Hex[1])-Ord('A')+10)*16;
If Hex[2] in ['0'..'9'] Then Temp:=Temp + Ord(Hex[2])-Ord('0');
If Hex[2] in ['A'..'F'] Then Temp:=Temp + Ord(Hex[2])-Ord('A')+10;
HexToDec:=Temp;
End;
Procedure CheckIntNumber(Var L:String;Var NewNumber:Boolean;
Var IntComment:String;Var IntCount:Word);
Const
LastInt :Word = 65000;
Var
DecStr :String[4];
DecNum :Word;
Begin
NewNumber:=False;
IntComment:='';
If Copy(L,1,4)='Int ' Then
Begin
Inc(IntCount);
L[6]:=UpCase(L[6]);
L[7]:=UpCase(L[7]);
L[8]:=UpCase(L[8]);
L[9]:=UpCase(L[9]);
DecNum:=HexToDec(Copy(L,5,2));
If (DecNum<>LastInt) And (DecNum<=240) And ((DecNum>=10) Or (DecNum=0)) Then
Begin
IntCount:=1;
LastInt:=DecNum;
Str(DecNum:3,DecStr);
IntComment:='Interrupt '+Copy(L,5,2)+'h'+' ('+DecStr+')';
If DecNum=240 Then IntComment:=IntComment+' ^Bto^B FFh (255)';
If DecNum= 0 Then IntComment:=IntComment+' ^Bto^B 09h ( 9)';
NewNumber:=True;
End;
If (DecNum>240) Or ((DecNum<10) And (DecNum<>0)) Then IntComment:='$$NO$$';
End;
If Copy(L,1,19)='Please Redistribute' Then
Begin
IntComment:='Final Comments From Ralf';
NewNumber:=True;
End;
End;
Function NGOFName(FName:String):String;
Begin
NGOFName:=Copy(FName,1,Pos('.',FName))+'NGO';
End;
Procedure NewMenuItem(Comment,FName:String);
Begin
WriteLn(MenuLink,' '+Comment+' '+NGOFName(FName));
End;
Procedure NewBatchItem(Command:String);
Begin
WriteLn(BatchJob,Command);
End;
Function NextOutputFileName:String;
Const
Total :Word = 0;
Var
Temp :String[3];
Begin
Inc(Total);
Str(Total,Temp);
FormatVar(Temp,Temp,3,RightText);
SpacesToZeros(Temp,Temp);
NextOutputFileName:='RB'+Temp+'.';
End;
Procedure I(Var S:String);
Begin
ReadLn(F,S);
End;
Procedure O(S:String);
Begin
WriteLn(G,S);
End;
Procedure OLn;
Begin
WriteLn(G);
End;
Procedure BoldEtc(StIn:String;Var StOut:String);
Var
SpPos:Byte;
Begin
StOut:=StIn;
SpPos:=Pos('Desc:',StOut);
If SpPos>0 Then
Begin
Delete(StOut,SpPos,5);
Insert('^BDesc:^B',StOut,SpPos);
End;
SpPos:=Pos('Note:',StOut);
If SpPos>0 Then
Begin
OLn;
Delete(StOut,SpPos,5);
Insert('^BNote:^B',StOut,SpPos);
End;
SpPos:=Pos('SeeAlso:',StOut);
If SpPos>0 Then
Begin
OLn;
Delete(StOut,SpPos,8);
Insert('^BSee Also:^B',StOut,SpPos);
End;
SpPos:=Pos('Return:',StOut);
If SpPos>0 Then
Begin
OLn;
Delete(StOut,SpPos,7);
Insert('^BReturn:^B',StOut,SpPos);
End;
SpPos:=Pos('Notes:',StOut);
If SpPos>0 Then
Begin
OLn;
Delete(StOut,SpPos,6);
Insert('^BNotes:^B',StOut,SpPos);
End;
End;
Procedure TabTo(StIn:String;Var StOut:String;TabSize:Byte);
Var
SpPos:Byte;
Spc :String;
Begin
StOut:=StIn;
Repeat
SpPos:=Pos(#9,StOut);
If SpPos>0 Then
Begin
Delete(StOut,SpPos,1);
PadVar('',Spc,TabSize - (SpPos Mod TabSize));
Insert(Spc,StOut,SpPos);
End;
Until SpPos=0;
End;
Procedure LoadConvertList(FromFile:String;Var CList:ConvertType);
Var
F :Text;
Cnt :Word;
St :String;
SpPos :Byte;
Begin
FillChar(CList,SizeOf(CList),0);
Cnt:=0;
Assign(F,FromFile);
{$I-}
Reset(F);
{$IFNDEF FINAL} {$I+} {$ENDIF}
If IOResult>0 Then Exit;
While (Not EOF(F)) And (Cnt<99) do
Begin
Inc(Cnt);
ReadLn(F,St);
SpPos:=Pos('|',St);
If SpPos>0 Then
Begin
If SpPos>11 Then SpPos:=11;
CList[Cnt].IfThis:=Copy(St,1,SpPos-1);
Delete(St,1,SpPos);
CList[Cnt].ThenThis:=Copy(St,1,10);
End;
End;
Close(F);
End;
{
Procedure BufferSeeAlsoComments(St:String);
Var
SpPos :Byte;
Begin
If Copy(St,1,13)='^BSee Also:^B' Then
Begin
If SeeAlsoLine='' Then SeeAlsoLine:='!SeeAlso:';
Delete(L,1,13);
UnPadVar(St,St);
While St<>'' do
Begin
SpPos:=Pos('INT ',St);
If SpPos>0 Then
Begin
If (Length(SeeAlsoLine)<240) Then
SeeAlsoLine:=SeeAlsoLine+' "'+Copy(St,SpPos,6)+'"';
SpPos:=Pos(',',St);
If SpPos>0 Then
Delete(St,1,SpPos)
Else
St:='';
End
Else
St:='';
End;
End;
End;
Procedure FlushSeeAlsoComments;
Begin
If SeeAlsoLine<>'' Then
Begin
O(SeeAlsoLine);
SeeAlsoLine:='';
End;
End;
}
Const
TabSize = 4;
ConvertFile = 'CONVERT.TXT';
MainRBFile = 'RBINT';
BatchFile = 'CRB.BAT';
NGC = 'CALL NGC';
NGML = 'CALL NGML';
Var
IntCount :Word;
Cnt :LongInt;
CodeLetter,
C :Char;
TempLine,
LastIntComment,
IntComment :String;
RBDir :String;
OutDir :String;
NewNumber :Boolean;
IntLetter :Char;
IntListFile,
FName :String[12];
LongCount :Word;
CList :ConvertType;
StopProc :Boolean;
Procedure CapWords(StIn:String;Var StOut:String);
Var
X :Word;
SpPos :Byte;
Begin
Strings.CapWords(StIn,StOut);
X:=1;
While CList[X].IfThis<>'' do
Begin
SpPos:=Pos(CList[X].IfThis,StOut);
If SpPos>0 Then
Begin
Delete(StOut,SpPos,Length(CList[X].IfThis));
Insert(CList[X].ThenThis,StOut,SpPos);
End;
Inc(X);
End;
End;
Begin
SeeAlsoLine:='';
RBDir:='';
OutDir:='';
StopProc:=False;
IntLetter:='A';
ClrScr;
WriteLn('Ralf Brown''s Text Format to .NG Format Version 1.02');
WriteLn('Copyright (c) Michael Gallias, 1992');
WriteLn;
WriteLn('Note that this program does NOT convert directly to .NG format, it converts');
WriteLn('the files to a new text format so that they can be compiled with the Norton');
WriteLn('Guides Compiler. You thus require the Norton Guides Compiler to convert the');
WriteLn('files. If you do not have this program, Ralf''s list is available in .NG');
WriteLn('format already. It should be at the same FTP site where you obtained this');
WriteLn('file.');
WriteLn;
WriteLn('Also note that the process requires 10 megabytes of free disk space.');
WriteLn('The program will run about 10 times faster if you use the SmartDrv write cache.');
WriteLn('For further details, please see the documentation.');
WriteLn;
WriteLn('If you don''t want the glossary or the low memory usage, delete the files');
WriteLn('GLOSSARY.LST and MEMORY.LST before running this program and they will not');
WriteLn('be included in the .NG.');
WriteLn;
WriteLn('This program has only been tested on release 34 files.');
WriteLn;
Write('Do you want to continue (Y)es (N)o ?');
C:=UpCase(ReadKey);
If C<>'Y' Then Halt;
ClrScr;
WriteLn('Specify the directory where this program and the original text files');
WriteLn('are to be found.');
WriteLn;
EditString(1,WhereY,60,True,RBDir);
If Length(RBDir)>2 Then
If RBDir[Length(RBDir)]<>'\' Then RBDir:=RBDir+'\';
WriteLn;
WriteLn;
WriteLn;
WriteLn('Specify the output directory for the new text files which need compiling.');
WriteLn;
EditString(1,WhereY,60,True,OutDir);
If Length(OutDir)>2 Then
If OutDir[Length(OutDir)]<>'\' Then OutDir:=OutDir+'\';
WriteLn;
WriteLn;
WriteLn('Press any key to start the process or [Esc] to quit to DOS.');
C:=ReadKey;
If C=#27 Then Halt;
ClrScr;
WriteLn('Converting Ralf''s list:');
WriteLn;
LoadConvertList(RBDir+ConvertFile,CList);
Assign(MenuLink,OutDir+MainRBFile);
Rewrite(MenuLink);
WriteLn(MenuLink,'!Name: Ralf Brown');
WriteLn(MenuLink,'!Credits: Ralf Brown''s Interrupt List Converted by Michael Gallias');
WriteLn(MenuLink,'!Menu: Lists');
Assign(BatchJob,OutDir+BatchFile);
Rewrite(BatchJob);
WriteLn(BatchJob,'@Echo Off');
Assign(F,RBDir+'INTERRUP.'+IntLetter);
Reset(F);
FName:=NextOutputFileName;
NewBatchItem(NGC+' '+FName);
NewMenuItem('Comments',FName);
Assign(G,OutDir+FName);
Rewrite(G);
O('!Short: Credits');
OLn;
O('^UCredits^U');
OLn;
Repeat
I(L);
If Copy(L,1,5)<>'-----' Then O(L);
Until Copy(L,1,5)='-----';
OLn;
O('This list was converted from the released text format to the');
O('Norton Guides / Expert Help Popup format by Michael Gallias.');
OLn;
O('Michael Gallias');
O('P O Box 22106');
O('Glenashley');
O('4022');
O('South Africa');
OLn;
O('gallias@ph.und.ac.za');
O('isapeg@images.cs.und.ac.za');
OLn;
O('For information on more shareware, send a blank message to the');
O('computer at icarus@ph.und.ac.za and it will reply to you.');
OLn;
Cnt:=1;
Repeat
Str(Cnt,L);
L:='Ralf''s Comment '+L;
O('!Short: '+L);
OLn;
O('^U'+L+'^U');
OLn;
Repeat
I(L);
If Copy(L,1,5)<>'-----' Then O(L);
Until Copy(L,1,5)='-----';
OLn;
Inc(Cnt);
CodeLetter:=L[9];
Delete(L,1,10);
Until L='00---------------------------------';
Close(G);
FName:=NextOutputFileName;
NewMenuItem('Interrupts',FName);
IntListFile:=FName;
Assign(G,OutDir+IntListFile);
Rewrite(G);
OLn;
NewBatchItem(NGC+' '+IntListFile);
WriteLn;
Cnt:=1;
IntCount:=1;
Repeat
I(L);
If Copy(L,1,3)='INT' Then
Begin
TempLine:=Copy(L,1,Pos('-',L));
TempLine[2]:='n';
TempLine[3]:='t';
Delete(L,1,Pos('-',L));
LowerCase(L,L);
CapWords(L,L);
L:=TempLine+L;
End
Else
Begin
LowerCase(L,L);
CapWords(L,L);
End;
CheckIntNumber(L,NewNumber,IntComment,IntCount);
If (NewNumber) And (IntComment<>'$$NO$$') Then
Begin
LastIntComment:=IntComment;
Close(G);
Assign(G,OutDir+IntListFile);
Append(G);
FName:=NextOutputFileName;
O('!Short: '+IntComment);
O('!File:'+NGOFName(FName));
OLn;
Close(G);
NewBatchItem(NGC+' '+FName);
Assign(G,OutDir+FName);
Rewrite(G);
End;
If IntCount>230 Then
Begin
IntCount:=1;
Close(G);
Assign(G,OutDir+IntListFile);
Append(G);
FName:=NextOutputFileName;
O('!Short: '+LastIntComment+' ^B(Cont.)^B');
O('!File:'+NGOFName(FName));
OLn;
Close(G);
NewBatchItem(NGC+' '+FName);
Assign(G,OutDir+FName);
Rewrite(G);
End;
GotoXY(1,WhereY-1);
Write(' ');
GotoXY(1,WhereY);
WriteLn(Cnt,' ',Copy(L,1,60));
O('!Short: '+Copy(L,1,76));
OLn;
If Copy(L,1,3)='Int' Then
Begin
TempLine:=Copy(L,1,73);
FormatVar(TempLine,TempLine,73,LeftText);
TempLine:='^U'+TempLine+'^U [^B'+CodeLetter+'^B]';
End
Else
TempLine:='^U'+Copy(L,1,76)+'^U';
O(TempLine);
OLn;
IntComment:=L;
LongCount:=0;
Repeat
I(L);
BoldEtc(L,L);
TabTo(L,L,TabSize);
Inc(LongCount,Length(L));
If (LongCount>11500) And (Copy(L,1,5)<>'-----') Then
Begin
Inc(IntCount);
LongCount:=0;
OLn;
O('^B.NG limit reached, continued in next section...^B');
OLn;
O('!Short: '+IntComment+' ^B(Cont.)^B');
OLn;
O('^U'+IntComment+'^B (Cont.)');
OLn;
End;
If Copy(L,1,5)<>'-----' Then
{ Begin}
O(L);
{ BufferSeeAlsoComments(L);
End
Else
FlushSeeAlsoComments;} {Can't see ahead to determine which file to reference}
Until (Copy(L,1,5)='-----') Or (EOF(F));
CodeLetter:=L[9];
OLn;
Inc(Cnt);
If EOF(F) Then
Begin
Close(F);
IntLetter:=Chr(Ord(IntLetter)+1);
Assign(F,RBDir+'INTERRUP.'+IntLetter);
{$I-}
Reset(F);
{$IFNDEF FINAL} {$I+} {$ENDIF}
If IOResult=0 Then
Begin
ReadLn(F);
ReadLn(F);
ReadLn(F);
End
Else
StopProc:=True;
End;
Until StopProc;
Close(G);
{End Interrupts}
{Check For Glossary}
Assign(F,RBDir+'GLOSSARY.LST');
{$I-}
Reset(F);
{$IFNDEF FINAL} {$I+} {$ENDIF}
If IOResult=0 Then
Begin
I(L);
I(L);
I(L);
I(L);
Cnt:=1;
FName:=NextOutputFileName;
NewMenuItem('Glossary',FName);
IntListFile:=FName;
Assign(G,OutDir+IntListFile);
Rewrite(G);
OLn;
NewBatchItem(NGC+' '+IntListFile);
Repeat
GotoXY(1,WhereY-1);
Write(' ');
GotoXY(1,WhereY);
WriteLn(Cnt,' ',Copy(L,1,60));
O('!Short: '+Copy(L,1,76));
OLn;
TempLine:='^U'+Copy(L,1,76)+'^U';
O(TempLine);
OLn;
Repeat
I(L);
BoldEtc(L,L);
TabTo(L,L,TabSize);
If L<>'' Then O(L);
Until (L='') Or (EOF(F));
OLn;
If Not EOF(F) Then I(L);
Inc(Cnt);
Until EOF(F);
Close(F);
Close(G);
End;
{End Check For Glossary}
{Check For Low Memory}
Assign(F,RBDir+'MEMORY.LST');
{$I-}
Reset(F);
{$IFNDEF FINAL} {$I+} {$ENDIF}
If IOResult=0 Then
Begin
I(L);
I(L);
I(L);
I(L);
Cnt:=1;
FName:=NextOutputFileName;
NewMenuItem('Memory',FName);
IntListFile:=FName;
Assign(G,OutDir+IntListFile);
Rewrite(G);
OLn;
NewBatchItem(NGC+' '+IntListFile);
Repeat
GotoXY(1,WhereY-1);
Write(' ');
GotoXY(1,WhereY);
If (L[Length(L)]=':') Then Delete(L,Length(L),1);
WriteLn(Cnt,' ',Copy(L,1,60));
O('!Short: '+Copy(L,1,76));
OLn;
TempLine:='^U'+Copy(L,1,76)+'^U';
O(TempLine);
OLn;
I(L);
Repeat
BoldEtc(L,L);
TabTo(L,L,TabSize);
If L<>'' Then O(L);
If Not EOF(F) Then I(L);
Until (Copy(L,1,9)='Format of') Or (EOF(F));
OLn;
Inc(Cnt);
Until EOF(F);
Close(F);
Close(G);
End;
{End Check For Low Memory}
NewBatchItem(NGML+' '+MainRBFile);
Close(MenuLink);
Close(BatchJob);
ClrScr;
WriteLn('Complete.');
WriteLn;
WriteLn('Now, go to the output directory and type CRB to compile the database.');
WriteLn('The database will be around 2.5 megabytes when complete.');
WriteLn;
WriteLn('Make sure the NGC (Norton Guides Compiler) and the NGML (Norton Guides');
WriteLn('Menu Linker) programs are on the path (or setup a batch file).');
WriteLn;
End.